home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Atari Mega Archive 1
/
Atari Mega Archive - Volume 1.iso
/
printing
/
frntback.lzh
/
FRNTBACK.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1988-06-05
|
25KB
|
636 lines
{ Copyright 1988 COMPUTE! Publications, Inc. All rights reserved. }
{$A+,D-,S3 }
PROGRAM front_and_back ;
CONST
{$I d:\p_pascal\gemconst.pas}
{$I D:\frntback.i }
AC_OPEN = 40 ;
AC_CLOSE= 41 ;
TYPE
{$I d:\p_pascal\gemtype.pas}
VAR
msg : message_buffer ; { GEM events buffer }
junk_title : Window_Title ; { just a place holder }
title : Str255 ; { desk menu title }
ap_id, { application no. for accessory register
}
wind_type, { just a place holder }
my_window : Integer ; { window identifier }
in_name, { file name }
in_path : Path_Name ; { path name }
dummy, { throw-away value }
rez, { resolution }
lm, { left margin }
tm, { top margin }
bm, { bottom margin }
form_len, { lines per page }
sp, { starting page }
ep, { ending page }
pg_offset : Integer ; { header pg no. }
print_init, { printer initiation string }
header_str : Str255 ; { header string }
rsc_found, { successful resource load? }
odd_pages, { print front pages? }
all_pages, { print both front & back pages? }
pauz : Boolean ; { page wait? }
{$I d:\p_pascal\gemsubs.pas}
(*****************************************************************************)
{ The following declarations have to be made in SOME versions of }
{ Personal Pascal. They are commented out here. If you get an }
{ undeclared identifier error, remove the curly brackets and }
{ allow these declarations to be included. }
{
PROCEDURE IO_Check( flag : boolean ) ;
EXTERNAL ;
FUNCTION IO_Result : Integer ;
EXTERNAL ;
}
(*****************************************************************************)
FUNCTION Menu_Register( id: Integer ; VAR name : Str255 ) : Integer ;
{ installs application as desk accessory }
EXTERNAL ;
(*****************************************************************************)
{ External form handling declarations }
PROCEDURE Obj_Draw( dialog : Dialog_Ptr ;
start, depth,
x,y,w,h : Integer ) ;
EXTERNAL ;
FUNCTION Obj_Find( dialog : Dialog_Ptr ;
start, depth,
mx,my : Integer ) : Integer ;
EXTERNAL ;
(*****************************************************************************)
PROCEDURE int_to_str ( n : Integer; VAR s : String ) ;
{ Converts integer n to char string s. }
PROCEDURE itoc( n1 : Integer; VAR s1 : String ) ;
{ Recursively converts digits of an integer into characters in a string. }
BEGIN
IF ( n1 < 0 ) THEN BEGIN
s1 := '-' ;
itoc( ABS( n1 ), s )
END
ELSE BEGIN
IF ( n1 >= 10 ) THEN
itoc( n1 DIV 10, s1 ) ;
s1 := Concat( s1, chr( n1 MOD 10 + ORD( '0' ) ) )
END
END ; { itoc }
BEGIN { int_to_str }
s := '' ;
itoc( n, s )
END ; { int_to_str }
FUNCTION str_to_int( VAR s : String ) : Integer ;
{ Convert ascii string to integer. Catches Long_Integer }
{ entries and truncates to maximum integer ( 32,767 ) }
VAR
sign : Integer ;
n : Long_Integer ;
BEGIN
WHILE NOT ( s[1] IN [ '0'..'9', '-', '+' ] ) AND ( length( s ) > 0 ) DO
Delete( s, 1, 1 ) ;
IF ( s[1] = '-' ) THEN
sign := -1
ELSE
sign := 1 ;
IF s[1] IN [ '+', '-' ] THEN
Delete( s, 1, 1 ) ;
n := 0 ;
WHILE ( s[1] IN [ '0' .. '9' ] ) AND ( length( s ) > 0 ) DO BEGIN
n := 10 * n + ( ORD( s[1]) - ORD( '0' ) ) ;
Delete( s, 1, 1 ) ;
END;
IF n > 32767 THEN
n := 32767 ;
str_to_int := sign * Int( n ) ;
END ; { str_to_int }
PROCEDURE refresh_screen ;
{ Puts a fresh coat of paint on the screen. }
VAR
x, y, w, h : Integer ;
wx, wy, ww, wh : Integer ;
BEGIN { refresh_screen }
hide_mouse ;
draw_mode( 1 ) ;
Paint_Color( GREEN ) ;
Paint_Outline( FALSE ) ;
First_Rect( my_window, x, y, w, h ) ;
Work_Rect( my_window, wx,wy,ww,wh ) ;
set_clip( wx, wy, ww, wh ) ;
WHILE ( w <> 0 ) AND ( h <> 0 ) DO BEGIN
IF Rect_Intersect( wx, wy, ww, wh, x, y, w, h) THEN BEGIN
IF rez = 2 THEN
Paint_Style(5)
ELSE
Paint_Style(1) ;
Paint_Rect( x,y,w,h ) ;
END ;
Next_Rect( my_window, x, y, w, h ) ;
END ; { while }
show_mouse ;
END { refresh_screen };
PROCEDURE draw_dialog( which : Integer ) ;
{ Finds 'which' dialog in the resource, and draws it. }
VAR
dialog : Dialog_Ptr ;
x,y,w,h : Integer ;
BEGIN { draw_dialog }
Find_Dialog( which, dialog ) ;
Center_Dialog( dialog ) ;
Work_Rect( my_window, x,y,w,h ) ;
Obj_Draw( dialog, 0,15, x,y,w,h ) ;
END ; { draw_dialog }
FUNCTION cancel_box( dialog : Dialog_Ptr ) : Boolean ;
{ Do we want to cancel printing operation? }
VAR
mx, my,
junk,
which : Integer ;
alert : Str255 ;
BEGIN
cancel_box := FALSE ;
which := Get_Event( E_TIMER | E_BUTTON | E_Message, 1, 1, 0, 0,
FALSE, 0, 0, 0, 0,
FALSE, 0, 0, 0, 0,
msg, junk, junk, junk,
mx, my, junk ) ;
IF which & E_BUTTON <> 0 THEN BEGIN
IF Obj_Find( dialog,0,15, mx,my ) = ABORT THEN BEGIN
Obj_SetState( dialog, ABORT, SELECTED,TRUE ) ;
end_dialog( dialog ) ;
refresh_screen ;
Obj_SetState( dialog, ABORT, NORMAL,FALSE ) ;
find_alert( FORSURE, alert ) ;
IF do_alert( alert,1 ) = 1 THEN
cancel_box := TRUE
ELSE BEGIN
cancel_box := FALSE ;
draw_dialog( PROGRESS ) ;
END ;
END ;
END ;
END ; { cancel_box }
PROCEDURE home_path( VAR path : Path_name ) ;
{ Builds a path name from whence we were launched. }
VAR
temp : String ;
ctr : Integer ;
FUNCTION getdrv : Integer ;
GEMDOS( $19 ) ;
PROCEDURE getdir( VAR buffer : String ; drive : Integer ) ;
GEMDOS( $47 ) ;
BEGIN { home_path }
path := Concat ( chr( getdrv + ORD('A') ), ':' ) ;
getdir( temp, 0 ) ;
ctr := 0 ;
WHILE ORD( temp[ctr]) <> 0 DO BEGIN
path := Concat( path, temp[ctr] ) ;
ctr := ctr+1 ;
END ;
END ; { home_path }
PROCEDURE initiate ;
{ Let's get something straight... }
FUNCTION getrez : Integer ;
XBIOS( 4 ) ;
BEGIN
wind_type := NONE ;
rez := Getrez ;
in_name := '' ;
home_path( in_path ) ;
in_path := Concat( in_path, '\*.*' ) ;
lm := 0 ;
tm := 0 ;
bm := 0 ;
form_len := 65 ;
sp := 1 ;
ep := 32767 ;
pg_offset := 0 ;
print_init := '' ;
header_str := '' ;
odd_pages :=